home *** CD-ROM | disk | FTP | other *** search
/ The Utilities Experience / The Utilities Experience - Volume 1.iso / software / icons+tools / picticon / source / picticon.e < prev    next >
Text File  |  1995-12-22  |  54KB  |  1,986 lines
  1. OPT LARGE
  2.  
  3. MODULE 'exec/nodes','exec/ports','exec/types','exec/memory',
  4.        'intuition/intuition','intuition/screens','intuition/gadgetclass',
  5.        'intuition/screens','dos/dos','dos/dosextens','gadtools',
  6.        'libraries/gadtools','graphics/rastport','graphics/gfx','graphics/text',
  7.        'graphics/view','graphics/gfxbase','workbench/workbench',
  8.        'workbench/startup','wb','icon','graphics/clip','diskfont',
  9.        'libraries/diskfont','libraries/iffparse','iffparse','Asl','libraries/Asl',
  10.        'datatypes/datatypes','datatypes/datatypesclass','datatypes/pictureclass',
  11.        'utility/hooks','intuition/classes','intuition/classusr','utility/tagitem',
  12.        'libraries/locale',
  13.              'mathffp','dos/dosasl',
  14.        'datatypes','layers','keymap','devices/inputevent','mathtrans','locale'
  15. MODULE 'newicon','libraries/newicon'
  16. MODULE    'utility'
  17. MODULE    'whatis','libraries/whatisbase'
  18.  
  19. MODULE    'tools/boopsi'
  20. MODULE    'mod/compare'
  21. MODULE    'mod/bits'
  22.  
  23. MODULE    '*doloaddt'
  24.  
  25. ENUM E_NONE,L_OK,
  26.   L_E_GENERAL,L_E_FILE,L_E_NOFILE,L_E_BADICON,L_E_NOWRITEICON,L_E_CLIP,
  27.   L_E_DATATYPE,L_E_NOPICTURE,L_E_GADGET,
  28.   L_EF_LIBRARY,L_EF_FATAL,L_EF_PUBSCREEN,L_EF_CHIPBUFFER,L_EF_VISUAL,L_EF_MENUS,
  29.   L_EF_MSGPORT,L_EF_WINDOW,L_EF_MEMORY,L_TEXTTITLE,
  30.   L_PICTURE,L_FILEOF,L_LOADING,L_SCALING,L_REMAPPING,L_SAVING,L_PERCENT,
  31.   L_TITLE,L_BODY,L_BUTTONS,L_RENDERING,L_PERCENT2,L_NUMDIRS,L_CREATINGICON,
  32.     L_DT_LOAD,L_DT_SCALE,L_DT_HISTO,L_DT_PICK,L_DT_RENDER,L_DT_CANCEL,L_DT_TITLE,
  33.     L_ENDS
  34.  
  35. ENUM MODE_CLI,MODE_WB,MODE_QUIET,MODE_APP
  36. ENUM TEXT_NORMAL,TEXT_SHADOW,TEXT_OUTLINE
  37.   OBJECT mybitmapstruct
  38.     bytesperrow:INT;rows:INT;flags:CHAR;depth:CHAR;pad:INT
  39.     plane1:LONG;plane2:LONG;plane3:LONG;plane4:LONG
  40.     plane5:LONG;plane6:LONG;plane7:LONG;plane8:LONG
  41.   ENDOBJECT
  42.  
  43. DEF dumstr[500]:STRING
  44. DEF texttype=TEXT_SHADOW,tallfont=FALSE
  45. DEF iff:PTR TO iffhandle,ierror
  46. DEF sp=NIL:PTR TO storedproperty
  47. DEF freeme=FALSE
  48. DEF curfile=1,totfile=1
  49. DEF screenfont=NIL:PTR TO textfont
  50. DEF drawinfo
  51. DEF showflag=FALSE,showx=0,showy=0,bitsizex,bitsizey,sizestr[50]:STRING
  52. DEF black,white,writecolors=2
  53. DEF posx=0,posy=0,sizex=0,sizey=0,centerflag=FALSE,posflag=FALSE
  54. DEF noappitem=FALSE
  55. DEF quietflag=FALSE,goodload
  56. DEF requestsizex,requestsizey,highestcolor
  57. DEF k[15]:LIST
  58. DEF redt[256]:LIST,grnt[256]:LIST,blut[256]:LIST
  59. DEF ditz,dang,dumb,body
  60. DEF osversion,quitter,newicon=FALSE
  61. DEF abort
  62. DEF aspectx=1,aspecty=1,useaspect=TRUE,addicon=FALSE,addiconoverwrite=FALSE
  63. DEF radian,pointfive
  64. DEF catalog,sl[500]:LIST
  65. DEF iconianheader[80]:STRING
  66. DEF scratch,ret,dummy
  67. DEF appimagedata,diskobj=NIL:PTR TO diskobject,newdiskobj=NIL:PTR TO newdiskobject
  68. DEF progname[500]:STRING,sleepername[500]:STRING,templatename[500]:STRING
  69. DEF backname[500]:STRING
  70. DEF gaugestr[100]:STRING
  71. DEF toolobject=NIL:PTR TO diskobject
  72. DEF stretch=FALSE
  73. DEF greyscale=0,quant=256
  74. DEF usewhatis=TRUE
  75. DEF maptopal[500]:STRING
  76. DEF icondir[500]:STRING
  77. DEF chunkyflag=FALSE,force8=FALSE,first4=-1
  78. DEF maxiwidth=128,maxiheight=100,maxiw=127,maxih=99
  79. DEF filename[500]:STRING
  80. DEF mode=MODE_CLI
  81. DEF scr=NIL:PTR TO screen,viewport:PTR TO viewport
  82. DEF bitmap:PTR TO bitmap,depth,colormap=0,newcolormap=0,cmbuf=0
  83. DEF currast=NIL:PTR TO rastport,curbitmap=NIL:PTR TO bitmap
  84. DEF appname[500]:STRING
  85. DEF visual=NIL,winx=-1,winy=-1
  86. DEF oldpx=-1
  87. DEF appx=-1,appy=-1
  88. DEF dither=TRUE,dithermode=DITH_FLOYD
  89. DEF twopass=FALSE
  90. DEF rawdata=0
  91. DEF div1=3,div2=0,div3=3,div4=1,rem1=8,rem2=1,rem3=8,rem4=4
  92. DEF thres=2,ignore=16,lim=255,typ=0
  93. DEF iinfo=0:PTR TO imageinfo
  94. DEF stacked[750]:LIST
  95. DEF renderham=FALSE
  96. DEF hamthres=-1
  97. DEF    hambase=FALSE
  98. DEF discard=FALSE
  99. DEF desx,desy,desw,desh
  100. DEF quantmode=QUANT_MEDIANCUT
  101.  
  102. PROC main()
  103.     DEF i,dlist
  104.     NEW iinfo
  105.   openlibs()
  106.   radian:=sp_div_tf_tf_f(10000,572958)
  107.   pointfive:=sp_div_tf_tf_f(10,5)
  108.   StrCopy(iconianheader,'Picticon 1.4',ALL)
  109.   StrCopy(icondir,'env:sys/',ALL)
  110.   dlist:=AttemptLockDosList(LDF_READ OR LDF_ALL)
  111.   IF (dlist<>0)
  112.       IF (FindDosEntry(dlist,'icons',LDF_ALL))
  113.           StrCopy(icondir,'Icons:',ALL)
  114.       ENDIF
  115.       UnLockDosList(LDF_READ OR LDF_ALL)
  116.   ENDIF
  117.   loadwinpos()
  118.   handwb()
  119.   savewinpos()
  120.   leave(0)
  121. ENDPROC
  122.  
  123. PROC setraw(x,y,r,g,b)
  124.   IF rawdata
  125.     PutLong(rawdata+(limit(x,0,maxiwidth)*12)+(limit(y,0,1)*12*maxiwidth),r)
  126.     PutLong(rawdata+(limit(x,0,maxiwidth)*12)+4+(limit(y,0,1)*12*maxiwidth),g)
  127.     PutLong(rawdata+(limit(x,0,maxiwidth)*12)+8+(limit(y,0,1)*12*maxiwidth),b)
  128.   ENDIF
  129. ENDPROC
  130.  
  131. PROC rawred(x,y)
  132.   RETURN Long(rawdata+(x*12)+(y*12*maxiwidth))
  133. ENDPROC
  134.  
  135. PROC rawgrn(x,y)
  136.   RETURN Long(rawdata+4+(x*12)+(y*12*maxiwidth))
  137. ENDPROC
  138.  
  139. PROC rawblu(x,y)
  140.   RETURN Long(rawdata+8+(x*12)+(y*12*maxiwidth))
  141. ENDPROC
  142.  
  143. PROC processicon() HANDLE
  144.   DEF gadget:PTR TO gadget
  145.   DEF backobj=NIL:PTR TO diskobject
  146.   DEF screenattr:PTR TO textattr,sfonth=8
  147.   DEF heystring[500]:STRING,file[500]:STRING,tmpstring[500]:STRING
  148.     DEF whaticon[500]:STRING
  149.   DEF iiii,tttt,oldshowx,loo,gc1,gc2
  150.     DEF inw,inh,lock
  151.     DEF imsg:PTR TO intuimessage
  152.     DEF whatobj=NIL:PTR TO diskobject
  153.     DEF newwhatobj=NIL:PTR TO newdiskobject
  154.     DEF filecolormap=NIL:PTR TO colormap
  155.     DEF numfilecolors=-1
  156.     DEF statwin=0:PTR TO statwindow
  157.     DEF status,res
  158.  
  159.     NEW statwin
  160.   oldshowx:=showx
  161.   IF StrLen(filename)<1 THEN Raise(E_NONE)
  162.   IF ((scr:=LockPubScreen('Workbench'))=0) THEN Raise(L_EF_PUBSCREEN)
  163.   visual:=GetVisualInfoA(scr,NIL)
  164.   viewport:=scr.viewport
  165.   colormap:=viewport.colormap
  166.   bitmap:=scr.bitmap
  167.   depth:=bitmap.depth
  168.  
  169.     IF StrLen(maptopal)
  170.         filecolormap:=GetColorMap(256)
  171.         res,numfilecolors:=doloadpalette(maptopal,filecolormap)
  172.         IF (res)
  173.             FreeColorMap(filecolormap);filecolormap:=0
  174.         ELSE
  175.             IF first4=-1
  176.                 first4:=numfilecolors
  177.             ELSE
  178.                 first4:=smaller(numfilecolors,first4)
  179.             ENDIF
  180.         ENDIF
  181.     ENDIF
  182.  
  183.     IF (newicon)
  184.         newcolormap:=GetColorMap(256)
  185.         cmbuf:=New(32)
  186.         FOR loo:=0 TO 255
  187.             gc1:=loo AND (Shl(1,depth)-1)
  188.             GetRGB32(colormap,gc1,1,cmbuf)
  189.             IF filecolormap
  190.                 GetRGB32(filecolormap,gc1,1,cmbuf)
  191.             ENDIF
  192.             SetRGB32CM(newcolormap,loo,Long(cmbuf),Long(cmbuf+4),Long(cmbuf+8))
  193.         ENDFOR
  194.         colormap:=newcolormap
  195.         Dispose(cmbuf)
  196.     ENDIF
  197.   IF (curbitmap:=myallocbitmap(maxiwidth,maxiheight,8,BMF_CLEAR OR BMF_STANDARD,NIL))=NIL THEN Raise(L_EF_CHIPBUFFER)
  198.  
  199.   IF (currast:=New(SIZEOF rastport))=NIL THEN Raise(L_EF_FATAL)
  200.   InitRastPort(currast);currast.bitmap:=curbitmap
  201.  
  202.   screenattr:=scr.font
  203.   sfonth:=screenattr.ysize
  204.  
  205.   IF ((mode<>MODE_QUIET) AND (mode<>MODE_CLI))
  206.     screenfont:=OpenFont(scr.font)
  207.     IF winx=-1 THEN winx:=(scr.width/2)
  208.     IF winy=-1 THEN winy:=(scr.height/2)
  209.  
  210.       statwin.scr:=scr
  211.       statwin.centerx:=winx
  212.       statwin.centery:=winy
  213.       statwin.textfont:=screenfont
  214.       statwin.textattr:=screenattr
  215.       statwin.textstyle:=0
  216.       statwin.load_string:=sl[L_DT_LOAD]
  217.         statwin.scale_string:=sl[L_DT_SCALE]
  218.         statwin.histogram_string:=sl[L_DT_HISTO]
  219.         statwin.quant_string:=sl[L_DT_PICK]
  220.         statwin.render_string:=sl[L_DT_RENDER]
  221.         statwin.cancel_string:=sl[L_DT_CANCEL]
  222.         statwin.title_string:=sl[L_DT_TITLE]
  223.  
  224.     StringF(tmpstring,sl[L_PICTURE],filename)
  225.     StrCopy(heystring,'  ',2)
  226.     StrAdd(heystring,tmpstring,ALL)
  227.     StrAdd(heystring,'  ',2)
  228.     IF ((totfile<-1) OR (totfile>1))
  229.         IF totfile>1
  230.           StringF(tmpstring,sl[L_FILEOF],curfile,totfile)
  231.         ELSE
  232.           StrCopy(tmpstring,sl[L_NUMDIRS],ALL)
  233.         ENDIF
  234.             StrAdd(tmpstring,'  ',2)
  235.         StrAdd(heystring,tmpstring,ALL)
  236.     ENDIF
  237.     statwin.status_string:=heystring
  238.     ELSE
  239.         IF (mode=MODE_CLI)
  240.             WriteF('\n"\s"...\n',filename)
  241.         ENDIF
  242.   ENDIF
  243.  
  244.     diskobj:=0;newdiskobj:=0
  245.     IF StrLen(templatename)
  246.         IF (newicon)
  247.             newdiskobj:=GetNewDiskObject(templatename)
  248.             IF (newdiskobj)
  249.                 diskobj:=newdiskobj.ndo_stdobject
  250.             ENDIF
  251.         ELSE
  252.             diskobj:=GetDiskObject(templatename)
  253.         ENDIF
  254.     ENDIF
  255.     
  256.     IF (diskobj=0)
  257.         IF (newicon)
  258.             newdiskobj:=GetNewDiskObject(filename)
  259.             IF (newdiskobj)
  260.                 diskobj:=newdiskobj.ndo_stdobject
  261.             ENDIF
  262.         ELSE
  263.             diskobj:=GetDiskObject(filename)
  264.         ENDIF
  265.     ENDIF
  266.     StrCopy(whaticon,'ENV:sys/def_project',ALL)
  267.  
  268.   IF (addiconoverwrite)
  269.     IF (newdiskobj)
  270.       FreeNewDiskObject(newdiskobj);newdiskobj:=0;diskobj:=0
  271.     ELSE
  272.       IF (diskobj);FreeDiskObject(diskobj);diskobj:=0;ENDIF
  273.     ENDIF
  274.   ENDIF
  275.    IF (diskobj=0)
  276.     IF (usewhatis<>0)
  277.       StrCopy(file,icondir,ALL)
  278.       IF (lock:=Lock(filename,ACCESS_READ))
  279.         AddPart(file,GetIconName(WhatIs(filename,[WI_DEEP,DEEPTYPE,NIL,NIL]:LONG)),490)
  280.         StrCopy(whaticon,file,ALL)
  281.         UnLock(lock)
  282.       ENDIF
  283.       IF (StrCmp(whaticon,icondir))
  284.         StrCopy(whaticon,'ENV:sys/def_project',ALL)
  285.       ENDIF
  286.       IF (newicon)
  287.         newdiskobj:=GetNewDiskObject(whaticon)
  288.         IF (newdiskobj)
  289.           diskobj:=newdiskobj.ndo_stdobject
  290.         ENDIF
  291.       ELSE
  292.         diskobj:=GetDiskObject(whaticon)
  293.       ENDIF
  294.     ELSE
  295.       IF (newicon)
  296.         newdiskobj:=GetNewDiskObject('env:sys/def_project')
  297.         IF (newdiskobj)
  298.           diskobj:=newdiskobj.ndo_stdobject
  299.         ENDIF
  300.       ELSE
  301.         diskobj:=GetDefDiskObject(WBPROJECT)
  302.       ENDIF
  303.     ENDIF
  304.   ENDIF
  305.     IF (diskobj=0)
  306.         IF (newicon)
  307.             newdiskobj:=GetNewDiskObject('ENV:sys/def_picture')
  308.             IF (newdiskobj)
  309.                 diskobj:=newdiskobj.ndo_stdobject
  310.             ENDIF
  311.         ELSE
  312.             diskobj:=GetDiskObject('ENV:sys/def_picture')            -> Next to last resort.
  313.         ENDIF
  314.     ENDIF
  315.     IF (diskobj=0) THEN diskobj:=GetDefDiskObject(WBPROJECT)                            -> Last resort.
  316.  
  317.   SetAPen(currast,0)
  318.   SetBPen(currast,0)
  319.   RectFill(currast,0,0,maxiw,maxih)
  320.   IF (StrLen(backname))
  321.       IF (backobj:=GetDiskObject(backname))
  322.             IF (newicon)
  323.                 IF (mode=MODE_CLI)
  324.                     WriteF('Background template ignored.\n')
  325.                 ENDIF
  326.             ELSE
  327.             gadget:=backobj.gadget
  328.                 copyimagerast(currast,gadget.gadgetrender)
  329.             ENDIF
  330.         ENDIF
  331.   ENDIF
  332.     goodload:=FALSE
  333.     StrCopy(gaugestr,{controlstring},ALL)
  334.     StrAdd(gaugestr,sl[L_PERCENT2],ALL)
  335.     IF filecolormap THEN colormap:=filecolormap
  336.     status:="canc"
  337.     IF (abort=FALSE)
  338.       status:=doloaddt(filename,currast,colormap,posx,posy,sizex,sizey,[DLDT_CENTER,centerflag,
  339.             DLDT_INTEGERSCALE,FALSE,
  340.             DLDT_DITHER,dither,
  341.             DLDT_DITHERTYPE,dithermode,
  342.             DLDT_REMAP,TRUE,
  343.             DLDT_ASPECTX,aspectx,
  344.             DLDT_ASPECTY,aspecty,
  345.             DLDT_SCALE,TRUE,
  346.             DLDT_USEASPECT,useaspect,
  347.             DLDT_ENLARGE,FALSE,
  348.             DLDT_CLEAR,FALSE,
  349.             DLDT_STATWINDOW,IF ((mode=MODE_WB) OR (mode=MODE_APP)) THEN statwin ELSE 0,
  350.             DLDT_CLIGAUGE,IF (mode=MODE_CLI) THEN gaugestr ELSE 0,
  351.             DLDT_INFO,iinfo,
  352.             DLDT_HIGHPEN,first4,
  353.             DLDT_FILLCMAP,((newicon<>0) AND (filecolormap=0)),
  354.             DLDT_GREYSCALE,greyscale,
  355.             DLDT_QUANTIZE,quant,
  356.             DLDT_RENDERHAM,renderham,
  357.             DLDT_FULLHAMBASE,hambase,
  358.             DLDT_DISCARDERROR,discard,
  359.             DLDT_STRETCHTOFIT,stretch,
  360.             IF (hamthres>=0) THEN DLDT_HAMTHRESHOLD ELSE TAG_IGNORE,hamthres,
  361.             NIL,NIL])
  362.     ENDIF
  363.     IF (status=0)
  364.         goodload:=TRUE
  365.     ELSE
  366.         IF (status="canc") THEN Raise("canc")
  367.         IF (addicon=FALSE)
  368.           errmsg(sl[L_E_DATATYPE])
  369.       ENDIF
  370.     ENDIF
  371.  
  372.     winx:=iinfo.statwindowx
  373.     winy:=iinfo.statwindowy
  374.     bitsizex:=iinfo.source_w
  375.     bitsizey:=iinfo.source_h
  376.     black:=iinfo.blackpen
  377.     white:=iinfo.whitepen
  378.     desx:=iinfo.destination_x
  379.     desy:=iinfo.destination_y
  380.     desw:=iinfo.destination_w
  381.     desh:=iinfo.destination_h
  382.  
  383. ->    writecolors:=limit((Shl(1,iinfo.depth)*2),1,255)
  384.     writecolors:=limit(iinfo.highest_pen+1,1,256)
  385.   IF showflag
  386.     StringF(sizestr,'\dx\d',bitsizex,bitsizey)
  387.     IF showx=-1 THEN showx:=posx+(sizex/2)-((StrLen(sizestr)*6)/2)
  388.     IF showy=-1 THEN showy:=1
  389.  
  390.     IF texttype=TEXT_OUTLINE
  391.       FOR tttt:=-1 TO 1
  392.         FOR iiii:=-1 TO 1
  393.           showpicsize(showx+iiii,showy+tttt,black,sizestr)
  394.         ENDFOR
  395.       ENDFOR
  396.     ENDIF
  397.     IF texttype=TEXT_SHADOW THEN showpicsize(showx+1,showy+1,black,sizestr)
  398.     showpicsize(showx,showy,white,sizestr)
  399.   ENDIF
  400.   showx:=oldshowx
  401.   IF goodload
  402.         IF newicon
  403.             savenewicon()
  404.         ELSE
  405.         saveicon()
  406.         ENDIF
  407.     ELSE
  408.         IF (addicon)
  409.             whatobj:=0;newwhatobj:=0
  410.             IF (((whatobj:=GetDiskObject(filename))=0) OR (addiconoverwrite=TRUE))
  411.                 IF (whatobj);FreeDiskObject(whatobj);whatobj:=0;ENDIF
  412.                 IF (newicon)
  413.                     newwhatobj:=GetNewDiskObject(whaticon)
  414.                     IF (newwhatobj)
  415.                         whatobj:=newwhatobj.ndo_stdobject
  416.                     ENDIF
  417.                 ENDIF
  418.                 IF (whatobj=0)
  419.                     whatobj:=GetDiskObjectNew(whaticon)
  420.                 ENDIF
  421.                 IF (whatobj)
  422.                     DeleteDiskObject(filename)
  423.                     IF (freeme)
  424.                         IF (whatobj.gadget)
  425.                             whatobj.gadget::gadget.leftedge:=NO_ICON_POSITION
  426.                             whatobj.gadget::gadget.topedge:=NO_ICON_POSITION
  427.                         ENDIF
  428.                         whatobj.currentx:=NO_ICON_POSITION
  429.                         whatobj.currenty:=NO_ICON_POSITION
  430.                     ENDIF
  431.                     IF ((newicon) AND (newwhatobj))
  432.                         PutNewDiskObject(filename,newwhatobj)
  433.                     ELSE
  434.                         PutDiskObject(filename,whatobj)
  435.                     ENDIF
  436.                 ENDIF
  437.                 IF (newwhatobj)
  438.                     FreeNewDiskObject(newwhatobj);newwhatobj:=0;whatobj:=0
  439.                 ENDIF
  440.             ENDIF
  441.             IF (whatobj)
  442.                 FreeDiskObject(whatobj);whatobj:=0
  443.             ENDIF
  444.         ENDIF
  445.   ENDIF
  446. EXCEPT DO
  447.     status:=exception
  448.     END statwin
  449.   IF visual THEN FreeVisualInfo(visual);visual:=NIL
  450.   IF scr THEN UnlockPubScreen(0,scr);scr:=NIL
  451.   IF curbitmap THEN myfreebitmap(curbitmap);curbitmap:=NIL
  452.   IF filecolormap THEN FreeColorMap(filecolormap);filecolormap:=NIL
  453.   IF currast THEN Dispose(currast);currast:=NIL
  454.     IF newicon
  455.         IF newdiskobj THEN FreeNewDiskObject(newdiskobj);newdiskobj:=NIL;diskobj:=NIL
  456.     ELSE
  457.       IF diskobj THEN FreeDiskObject(diskobj);diskobj:=NIL
  458.     ENDIF
  459.   IF backobj THEN FreeDiskObject(backobj);backobj:=NIL
  460.     IF (newicon)
  461.         IF (newcolormap)
  462.             FreeColorMap(newcolormap)
  463.         ENDIF
  464.     ENDIF
  465.   savewinpos()
  466.   IF screenfont THEN CloseFont(screenfont);screenfont:=NIL
  467.   IF ((status<>0) AND (status<>"canc")) THEN handleexception(status)
  468. ENDPROC status
  469.  
  470. PROC shadowline(rast,x1,y1,x2,y2)
  471.     DEF drawinfo=NIL:PTR TO drawinfo
  472.     IF ((scr=0) OR (rast=0)) THEN RETURN
  473.     IF (drawinfo:=GetScreenDrawInfo(scr))
  474.         SetAPen(rast,Int(drawinfo.pens+(SHINEPEN*2)))
  475.         Move(rast,x1+1,y1+1)
  476.         Draw(rast,x2+1,y2+1)
  477.         SetAPen(rast,Int(drawinfo.pens+(SHADOWPEN*2)))
  478.         Move(rast,x1,y1)
  479.         Draw(rast,x2,y2)
  480.         FreeScreenDrawInfo(scr,drawinfo)
  481.     ENDIF
  482. ENDPROC
  483.  
  484. PROC shadowtext(rast,x1,y1,x2,y2)
  485.     DEF drawinfo=NIL:PTR TO drawinfo
  486.     IF ((scr=0) OR (rast=0)) THEN RETURN
  487.     IF (drawinfo:=GetScreenDrawInfo(scr))
  488.         SetDrMd(rast,RP_JAM1)
  489. /*        SetAPen(rast,Int(drawinfo.pens+(SHINEPEN*2)))
  490.         Move(rast,x1+1,y1+1)
  491.         Text(rast,x2,y2)*/
  492.         SetAPen(rast,Int(drawinfo.pens+(SHADOWPEN*2)))
  493.         Move(rast,x1,y1)
  494.         Text(rast,x2,y2)
  495.         FreeScreenDrawInfo(scr,drawinfo)
  496.         SetDrMd(rast,RP_JAM2)
  497.     ENDIF
  498. ENDPROC
  499.  
  500. PROC saveicon() HANDLE
  501.   DEF ire
  502.   DEF mydiskobj=NIL:PTR TO diskobject
  503.  
  504.   mydiskobj:=diskobj
  505.  
  506.   IF mode=MODE_CLI THEN WriteF('\n')
  507.   creatediskobj(mydiskobj,currast)
  508.  
  509.   IF (ire:=PutDiskObject(filename,mydiskobj))=NIL THEN Raise(L_E_NOWRITEICON)
  510.  
  511.   Raise(E_NONE)
  512. EXCEPT
  513.   restorediskobj(mydiskobj)
  514.   handleexception(exception)
  515. ENDPROC
  516.  
  517. oldimage:
  518.     INT 0,0,1,1,1
  519. fillim:
  520.     LONG 0    ->FILL ME
  521.     CHAR 1,0
  522.     LONG 0
  523.  
  524. image:
  525.     LONG $FFFF
  526.  
  527. PROC savenewicon() HANDLE
  528.   DEF ire,i,x,y
  529.     DEF chunk=NIL:PTR TO chunkyimage,ctab=NIL,ci=NIL
  530.   DEF mydiskobj=NIL:PTR TO diskobject
  531.     DEF myni=NIL:PTR TO newdiskobject
  532.     DEF iconsizex,iconsizey
  533.     DEF buffer=NIL
  534.     DEF file[500]:STRING
  535.  
  536.     NEW chunk,myni
  537.     ctab:=New(260*3)
  538.     ci:=New(maxiwidth*maxiheight*2)
  539.     buffer:=New(20)
  540.  
  541.   mydiskobj:=diskobj
  542.  
  543.   IF mode=MODE_CLI THEN WriteF('\n')
  544.   creatediskobj(mydiskobj,currast)
  545.  
  546.     PutLong({fillim},{image})
  547.     mydiskobj.gadget::gadget.width:=1
  548.     mydiskobj.gadget::gadget.height:=1
  549.  
  550.     mydiskobj.gadget::gadget.gadgetrender:={oldimage}
  551.  
  552.     myni.ndo_stdobject:=mydiskobj
  553.     myni.ndo_normalimage:=chunk
  554.  
  555.   iconsizex:=smaller(bigger(bigger(requestsizex,(desx+desw)),8),92)
  556.   iconsizey:=smaller(bigger(bigger(requestsizey,(desy+desh)),8),92)
  557.     chunk.width:=iconsizex
  558.     chunk.height:=iconsizey-1
  559.     chunk.numcolors:=writecolors+1
  560.     chunk.flags:=0                                -> Color 0 in NOT transparent!
  561.     chunk.palette:=ctab
  562.     chunk.chunkydata:=ci
  563.  
  564.     FOR i:=0 TO writecolors
  565.         GetRGB32(newcolormap,i,1,buffer)
  566.         PutChar(ctab+(i*3)+0,Char(buffer))
  567.         PutChar(ctab+(i*3)+1,Char(buffer+4))
  568.         PutChar(ctab+(i*3)+2,Char(buffer+8))
  569.     ENDFOR
  570.  
  571.     FOR y:=0 TO iconsizey-1
  572.         FOR x:=0 TO iconsizex-1
  573.             PutChar(ci+(y*iconsizex)+x,ReadPixel(currast,x,y))
  574.         ENDFOR
  575.     ENDFOR
  576.  
  577.     StrCopy(file,filename,ALL)
  578.     StrAdd(file,'.info',ALL)
  579.     DeleteFile(file)
  580.     DeleteDiskObject(filename)
  581.   IF (ire:=PutNewDiskObject(filename,myni))=NIL THEN Raise(L_E_NOWRITEICON)
  582.   Raise(E_NONE)
  583. EXCEPT
  584.   restorediskobj(mydiskobj)
  585.   handleexception(exception)
  586.     Dispose(ctab);Dispose(ci);Dispose(buffer)
  587.     END chunk,myni
  588. ENDPROC
  589.  
  590. PROC displaymessage(msg,flag)
  591.   IF mode=MODE_CLI
  592.     WriteF('\s\n',msg)
  593.   ELSE
  594.          EasyRequestArgs(0, [20, 0, sl[L_TEXTTITLE], msg,sl[L_OK]], 0, 0)
  595.   ENDIF
  596. ENDPROC
  597.  
  598. PROC showpicsize(x,y,p,s)
  599.   DEF ii,tt,uu,mm,charptr,xptr,ysize=6
  600.   charptr:={chardata}
  601.   xptr:={xdata}
  602.   IF tallfont
  603.     ysize:=8
  604.     charptr:={chardatal}
  605.     xptr:={xdatal}
  606.   ENDIF
  607.   SetAPen(currast,p)
  608.   FOR ii:=0 TO (StrLen(s)-1)
  609.     mm:=Char(s+ii)
  610.     FOR tt:=0 TO (ysize-1)
  611.       FOR uu:=0 TO 5
  612.         IF mm<>"x"
  613.           IF Char(charptr+uu+(tt*8)+((mm-48)*(8*ysize)))="x"
  614.             WritePixel(currast,smaller(bigger(x+uu+(ii*6),0),maxiw),smaller(bigger(y+tt,0),maxih))
  615.           ENDIF
  616.         ELSE
  617.           IF Char(xptr+uu+(tt*8))="x"
  618.             WritePixel(currast,smaller(bigger(x+uu+(ii*6),0),maxiw),smaller(bigger(y+tt,0),maxih))
  619.           ELSE
  620.           ENDIF
  621.         ENDIF
  622.       ENDFOR
  623.     ENDFOR
  624.   ENDFOR
  625.  
  626. ENDPROC
  627.  
  628. PROC postprocessicon()
  629.     DEF ii
  630.     FOR ii:=0 TO 749
  631.         IF (stacked[ii]=0)
  632.             stacked[ii]:=String(StrLen(filename)+6)
  633.             StrCopy(stacked[ii],filename,ALL)
  634.             ii:=5000
  635.         ENDIF
  636.     ENDFOR
  637. ENDPROC
  638.  
  639. PROC dosleep()
  640.   DEF sleepobject=NIL:PTR TO diskobject
  641.   DEF appobject=NIL:PTR TO diskobject
  642.   DEF appport=NIL:PTR TO mp
  643.   DEF appflag=NIL
  644.   DEF appicon,appitem=FALSE,newproj[250]:STRING
  645.   DEF lockname[250]:STRING,newlock=NIL
  646.   DEF amsg:PTR TO appmessage
  647.   DEF argptr:PTR TO wbarg
  648.   DEF lofal
  649.     DEF fh
  650.   DEF agadget:PTR TO gadget
  651.     DEF fileinfo=NIL:PTR TO fileinfoblock
  652.     DEF fileinfo1=NIL:PTR TO fileinfoblock
  653.     DEF apath=NIL:PTR TO anchorpath
  654.     DEF    achain=NIL:PTR TO achain
  655.     DEF err,pathlen,filestart,first
  656.     DEF patstr[500]:STRING
  657.     DEF dirstr[500]:STRING
  658.     DEF dumstr[500]:STRING,i
  659.     DEF retu
  660.  
  661.   StrCopy(appname,sleepername,ALL)
  662.   IF (sleepobject:=GetDiskObject(appname))=NIL
  663.     IF (sleepobject:=GetDiskObject('ENV:SYS/def_appicon'))=NIL
  664.       StrCopy(appname,progname,ALL)
  665.       IF (sleepobject:=GetDiskObject(appname))=NIL
  666.         sleepobject:=GetDefDiskObject(WBTOOL)
  667.       ENDIF
  668.     ENDIF
  669.   ENDIF
  670.   IF sleepobject
  671.     sleepobject.type:=NIL
  672.     appobject:=sleepobject
  673.     agadget:=appobject.gadget
  674.     IF appx<0
  675.       agadget.leftedge:=NO_ICON_POSITION
  676.       appobject.currentx:=NO_ICON_POSITION
  677.     ELSE
  678.       agadget.leftedge:=appx
  679.       appobject.currentx:=appx
  680.     ENDIF
  681.     IF appy<0
  682.       agadget.topedge:=NO_ICON_POSITION
  683.       appobject.currenty:=NO_ICON_POSITION
  684.     ELSE
  685.       agadget.topedge:=appy
  686.       appobject.currenty:=appy
  687.     ENDIF
  688.  
  689.     IF (appport:=CreateMsgPort())
  690.       IF (appicon:=AddAppIconA(0,0,'Picticon',appport,0,appobject,NIL))<>NIL
  691.           IF (noappitem<>TRUE)
  692.               appitem:=AddAppMenuItemA(0,0,'Picticon',appport,0)
  693.           ENDIF
  694.           IF ((appitem) OR (noappitem=TRUE))
  695.             WHILE appflag=NIL
  696.               WaitPort(appport)
  697.               WHILE (amsg:=GetMsg(appport))<>NIL
  698.                 IF amsg.numargs=0
  699.                   IF EasyRequestArgs(0, [20, 0, sl[L_TITLE], sl[L_BODY],sl[L_BUTTONS]], 0, 0)
  700.                     appflag:=TRUE
  701.                   ENDIF
  702.                 ELSE
  703.                     abort:=FALSE
  704.                   argptr:=amsg.arglist
  705.                   curfile:=0
  706.                   FOR lofal:=1 TO amsg.numargs
  707.                                     totfile:=amsg.numargs
  708.                       curfile:=curfile+1
  709.                     StrCopy(newproj,argptr.name,ALL)
  710.                     newlock:=argptr.lock
  711.                     IF newlock
  712.                         IF (fileinfo1:=AllocDosObject(DOS_FIB,NIL))
  713.                           NameFromLock(newlock,lockname,250)
  714.                             processname(filename,lockname,newproj)
  715.                                             IF (fh:=Lock(filename,ACCESS_READ))
  716.                                 Examine(fh,fileinfo1)
  717.                                 IF (fileinfo1.direntrytype>0)
  718.                                     StrCopy(patstr,filename,ALL)
  719.                                     StrCopy(dirstr,filename,ALL)
  720.                                     AddPart(patstr,'~(#?.info)',490)
  721.                                                     apath:=New(SIZEOF anchorpath)
  722.                                                     first:=FALSE
  723.                                                     err:=0
  724.                                                     WHILE err=NIL
  725.                                                         IF first=FALSE
  726.                                                             err:=MatchFirst(patstr,apath)
  727.                                                             first:=TRUE
  728.                                                         ELSE
  729.                                                             err:=MatchNext(apath)
  730.                                                         ENDIF
  731.                                                         IF err=NIL
  732.                                                             achain:=apath.last
  733.                                                             IF (achain)
  734.                                                                 fileinfo:=achain.info
  735.                                                                 IF (fileinfo)
  736.                                                                     IF (fileinfo.direntrytype<0)
  737.                                                                         StrCopy(filename,dirstr,ALL)
  738.                                                                         AddPart(filename,fileinfo.filename,490)
  739.                                                                         StrCopy(dumstr,filename,ALL)
  740.                                                                         UpperStr(dumstr)
  741.                                                                         IF (InStr(dumstr,'.INFO')<0)
  742.                                                                             totfile:=-2
  743.                                                                         postprocessicon()
  744.                                                                         ENDIF
  745.                                                                     ENDIF
  746.                                                                 ENDIF
  747.                                                             ENDIF
  748.                                                         ENDIF
  749.                                                     ENDWHILE
  750.                                                     MatchEnd(apath)
  751.                                                     Dispose(apath)
  752.                                                     FOR i:=0 TO 749
  753.                                                         IF stacked[i]<>0
  754.                                                             StrCopy(filename,stacked[i],ALL)
  755.                                                             retu:=processicon()
  756.                                                             IF (retu="canc") THEN abort:=TRUE
  757.                                                         ENDIF
  758.                                                         IF CtrlC();i:=5000;appflag:=TRUE;ENDIF
  759.                                                         IF (abort);i:=5000;ENDIF
  760.                                                     ENDFOR
  761.                                                     FOR i:=0 TO 749
  762.                                                         IF stacked[i]<>0
  763.                                                             DisposeLink(stacked[i])
  764.                                                             stacked[i]:=0
  765.                                                         ENDIF
  766.                                                     ENDFOR
  767.                                 ELSE
  768.                                     IF (fileinfo1.direntrytype<0)
  769.                                                         retu:=processicon()
  770.                                                         IF (retu="canc") THEN abort:=TRUE
  771.                                     ENDIF
  772.                                                 ENDIF
  773.                                                 UnLock(fh)
  774.                             ENDIF
  775.                              FreeDosObject(DOS_FIB,fileinfo1)
  776.                         ENDIF
  777.                     ENDIF
  778.                     argptr:=argptr+(SIZEOF wbarg)
  779.                                     IF CtrlC();lofal:=50000;appflag:=TRUE;ENDIF
  780.                                     IF (abort<>FALSE);lofal:=50000;ENDIF
  781.                   ENDFOR
  782.                 ENDIF
  783.                 ReplyMsg(amsg)
  784.                         ENDWHILE
  785.             ENDWHILE
  786.             IF (appitem) THEN RemoveAppMenuItem(appitem);appitem:=0
  787.                 ENDIF
  788.            RemoveAppIcon(appicon)
  789.       ENDIF
  790.          WHILE (amsg:=GetMsg(appport))<>NIL
  791.            ReplyMsg(amsg)
  792.          ENDWHILE
  793.       DeleteMsgPort(appport)
  794.     ENDIF
  795.     IF sleepobject THEN FreeDiskObject(sleepobject);sleepobject:=NIL
  796.   ENDIF
  797. ENDPROC
  798.  
  799. yes:
  800.     CHAR    'YES',0
  801. no:
  802.     CHAR    'NO',0
  803. true:
  804.     CHAR    'TRUE',0
  805. false:
  806.     CHAR    'FALSE',0
  807.  
  808. PROC handwb()
  809.   DEF wb:PTR TO wbstartup,args:PTR TO wbarg
  810.   DEF argarray[70]:LIST,olddir,rdarg,s,wstr[500]:STRING
  811.   DEF locs,namesptr:PTR TO LONG,patternstr[500]:STRING
  812.     DEF fileinfo=NIL:PTR TO fileinfoblock
  813.     DEF    achain=NIL:PTR TO achain
  814.     DEF err=0,pathlen,filestart,first=0,chance=1
  815.     DEF    newdate=NIL:PTR TO datestamp
  816.     DEF apath=NIL:PTR TO anchorpath,i
  817.     DEF retu
  818.  
  819.   IF wbmessage<>NIL /* E provides us with WB's startup message in this variable */
  820.     wb:=wbmessage;args:=wb.arglist
  821.     olddir:=CurrentDir(args.lock)
  822.  
  823.     IF args.name>0
  824.       GetCurrentDirName(progname,500)
  825.       StrAdd(progname,args.name,ALL)
  826.       toolobject:=GetDiskObjectNew(progname)
  827.     ENDIF
  828.  
  829.     IF toolobject<>NIL  /* If we succeded in opening our program icon. */
  830.       IF s:=FindToolType(toolobject.tooltypes,'MAXIWIDTH')
  831.         StrToLong(s,{maxiwidth})
  832.       ENDIF
  833.       IF s:=FindToolType(toolobject.tooltypes,'MAXIHEIGHT')
  834.         StrToLong(s,{maxiheight})
  835.       ENDIF
  836.       IF s:=FindToolType(toolobject.tooltypes,'APPICON')
  837.         StrCopy(sleepername,s,ALL)
  838.       ENDIF
  839.             IF s:=FindToolType(toolobject.tooltypes,'NOAPPITEM')
  840.                 IF yup(s) THEN noappitem:=TRUE
  841.             ENDIF
  842.       IF s:=FindToolType(toolobject.tooltypes,'TEMPLATE_ICON')
  843.         StrCopy(templatename,s,ALL)
  844.       ENDIF
  845.       IF s:=FindToolType(toolobject.tooltypes,'BACKGROUND_ICON')
  846.         StrCopy(backname,s,ALL)
  847.       ENDIF
  848.       IF s:=FindToolType(toolobject.tooltypes,'PALETTE')
  849.         StrCopy(maptopal,s,ALL)
  850.       ENDIF
  851.       IF s:=FindToolType(toolobject.tooltypes,'ICONDIR')
  852.         StrCopy(icondir,s,ALL)
  853.       ENDIF
  854.       IF s:=FindToolType(toolobject.tooltypes,'CHUNKYMODE')
  855.                 chunkyflag:=yup(s)
  856.       ENDIF
  857.       IF s:=FindToolType(toolobject.tooltypes,'FORCE_EIGHT')
  858.         force8:=yup(s)
  859.       ENDIF
  860.       IF s:=FindToolType(toolobject.tooltypes,'CENTER')
  861.         centerflag:=yup(s)
  862.       ENDIF
  863.       IF s:=FindToolType(toolobject.tooltypes,'HIGHPEN')
  864.         StrToLong(s,{first4})
  865.       ENDIF
  866.       IF s:=FindToolType(toolobject.tooltypes,'FIRSTFOUR')
  867.         IF yup(s) THEN first4:=3
  868.       ENDIF
  869.       IF s:=FindToolType(toolobject.tooltypes,'FREE_ICON_POS')
  870.         freeme:=yup(s)
  871.       ENDIF
  872.       IF s:=FindToolType(toolobject.tooltypes,'PIC_X_POS')
  873.         StrToLong(s,{posx})
  874.       ENDIF
  875.       IF s:=FindToolType(toolobject.tooltypes,'PIC_Y_POS')
  876.         StrToLong(s,{posy})
  877.       ENDIF
  878.       IF s:=FindToolType(toolobject.tooltypes,'APP_X_POS')
  879.         StrToLong(s,{appx})
  880.       ENDIF
  881.       IF s:=FindToolType(toolobject.tooltypes,'APP_Y_POS')
  882.         StrToLong(s,{appy})
  883.       ENDIF
  884.       IF s:=FindToolType(toolobject.tooltypes,'PIC_X_SIZE')
  885.         StrToLong(s,{sizex})
  886.       ENDIF
  887.       IF s:=FindToolType(toolobject.tooltypes,'PIC_Y_SIZE')
  888.         StrToLong(s,{sizey})
  889.       ENDIF
  890.       IF s:=FindToolType(toolobject.tooltypes,'SHOWSIZE_X')
  891.         StrToLong(s,{showx})
  892.         showflag:=TRUE
  893.       ENDIF
  894.       IF s:=FindToolType(toolobject.tooltypes,'SHOWSIZE_Y')
  895.         StrToLong(s,{showy})
  896.         showflag:=TRUE
  897.       ENDIF
  898.       IF s:=FindToolType(toolobject.tooltypes,'ASPECT_X')
  899.         StrToLong(s,{aspectx})
  900.       ENDIF
  901.       IF s:=FindToolType(toolobject.tooltypes,'QUANTIZE')
  902.         StrToLong(s,{quant})
  903.       ENDIF
  904.       IF s:=FindToolType(toolobject.tooltypes,'ASPECT_Y')
  905.         StrToLong(s,{aspecty})
  906.       ENDIF
  907.       IF s:=FindToolType(toolobject.tooltypes,'HAMTHRESHOLD')
  908.         StrToLong(s,{hamthres})
  909.       ENDIF
  910.       IF s:=FindToolType(toolobject.tooltypes,'LOWPRI')
  911.         IF yup(s) THEN SetTaskPri(FindTask(0),-1)
  912.       ENDIF
  913.       IF s:=FindToolType(toolobject.tooltypes,'SHOWSIZE_OUTLINE')
  914.         IF yup(s)
  915.           texttype:=TEXT_OUTLINE
  916.         ENDIF
  917.       ENDIF
  918.       IF s:=FindToolType(toolobject.tooltypes,'SHOWSIZE_NORMAL')
  919.         IF yup(s)
  920.           texttype:=TEXT_NORMAL
  921.         ENDIF
  922.       ENDIF
  923.       IF s:=FindToolType(toolobject.tooltypes,'SHOWSIZE_TALL')
  924.         IF yup(s)
  925.           tallfont:=TRUE
  926.         ENDIF
  927.       ENDIF
  928.       IF s:=FindToolType(toolobject.tooltypes,'QUIET')
  929.         IF yup(s)
  930.           quietflag:=TRUE
  931.                     mode:=MODE_QUIET
  932.         ENDIF
  933.       ENDIF
  934.  
  935.       IF s:=FindToolType(toolobject.tooltypes,'ADDICON')
  936.         IF yup(s) THEN addicon:=TRUE
  937.       ENDIF
  938.       IF s:=FindToolType(toolobject.tooltypes,'OVERWRITE')
  939.         IF yup(s) THEN addiconoverwrite:=TRUE
  940.       ENDIF
  941.  
  942.       IF s:=FindToolType(toolobject.tooltypes,'DITHER')
  943.         IF nope(s)
  944.           dither:=FALSE
  945.         ENDIF
  946.       ENDIF
  947.  
  948.       IF s:=FindToolType(toolobject.tooltypes,'DITHERTYPE')
  949.           StrCopy(dumstr,s,ALL)
  950.           UpperStr(dumstr)
  951.           IF StrCmp(dumstr,'FLOYD') THEN dithermode:=DITH_FLOYD
  952.           IF StrCmp(dumstr,'STUCKI') THEN dithermode:=DITH_STUCKI
  953.           IF StrCmp(dumstr,'BURKES') THEN dithermode:=DITH_BURKES
  954.           IF StrCmp(dumstr,'ERRORDIFF') THEN dithermode:=DITH_ERRORDIFF
  955.           IF StrCmp(dumstr,'1') THEN dithermode:=DITH_FLOYD
  956.           IF StrCmp(dumstr,'2') THEN dithermode:=DITH_STUCKI
  957.           IF StrCmp(dumstr,'3') THEN dithermode:=DITH_BURKES
  958.           IF StrCmp(dumstr,'0') THEN dithermode:=DITH_ERRORDIFF
  959.       ENDIF
  960.  
  961.       IF s:=FindToolType(toolobject.tooltypes,'QUANTMODE')
  962.           StrCopy(dumstr,s,ALL)
  963.           UpperStr(dumstr)
  964.           IF StrCmp(dumstr,'POPULARITY') THEN quantmode:=QUANT_POPULARITY
  965.           IF StrCmp(dumstr,'MEDIANCUT') THEN quantmode:=QUANT_MEDIANCUT
  966.           IF StrCmp(dumstr,'VERBATIM') THEN quantmode:=QUANT_VERBATIM
  967.           IF StrCmp(dumstr,'1') THEN quantmode:=QUANT_POPULARITY
  968.           IF StrCmp(dumstr,'2') THEN quantmode:=QUANT_MEDIANCUT
  969.           IF StrCmp(dumstr,'0') THEN quantmode:=QUANT_VERBATIM
  970.       ENDIF
  971.  
  972.       IF s:=FindToolType(toolobject.tooltypes,'NEWICON')
  973.         IF yup(s)
  974.                     IF (newiconbase)
  975.               newicon:=TRUE
  976.                     ENDIF
  977.         ENDIF
  978.       ENDIF
  979.       IF s:=FindToolType(toolobject.tooltypes,'WHATIS')
  980.         IF nope(s) THEN usewhatis:=FALSE
  981.       ENDIF
  982.       IF s:=FindToolType(toolobject.tooltypes,'STRETCH')
  983.         IF yup(s) THEN stretch:=TRUE
  984.       ENDIF
  985.       IF s:=FindToolType(toolobject.tooltypes,'RENDERHAM6')
  986.         IF yup(s) THEN renderham:=6
  987.       ENDIF
  988.       IF s:=FindToolType(toolobject.tooltypes,'RENDERHAM8')
  989.         IF yup(s) THEN renderham:=8
  990.       ENDIF
  991.       IF s:=FindToolType(toolobject.tooltypes,'FULLHAMBASE')
  992.         IF yup(s) THEN hambase:=TRUE
  993.       ENDIF
  994.       IF s:=FindToolType(toolobject.tooltypes,'DISCARDERROR')
  995.         IF yup(s) THEN discard:=TRUE
  996.       ENDIF
  997.       IF s:=FindToolType(toolobject.tooltypes,'GREYSCALE')
  998.         IF yup(s) THEN greyscale:=1
  999.       ENDIF
  1000.       IF s:=FindToolType(toolobject.tooltypes,'LUMSCALE')
  1001.         IF yup(s) THEN greyscale:=2
  1002.       ENDIF
  1003.     ENDIF
  1004.     IF wb.numargs>1
  1005.       totfile:=wb.numargs-1
  1006.       curfile:=1
  1007.             abort:=FALSE
  1008.       FOR locs:=2 TO wb.numargs
  1009.         olddir:=args[].lock++
  1010.         IF args.lock
  1011.           olddir:=CurrentDir(args.lock)
  1012.           GetCurrentDirName(filename,250)
  1013.           NameFromLock(args.lock,wstr,240)
  1014.           CurrentDir(olddir)
  1015.           processname(filename,wstr,args.name)
  1016.           mode:=MODE_WB
  1017.           enforcemax()
  1018.                     retu:=processicon()
  1019.                     IF (retu="canc") THEN abort:=TRUE
  1020.         ENDIF
  1021.         curfile:=curfile+1
  1022.                 IF CtrlC();locs:=50000;ENDIF
  1023.                 IF (abort<>0);locs:=50000;ENDIF
  1024.       ENDFOR
  1025.     ELSE
  1026.       mode:=MODE_APP
  1027.       enforcemax()
  1028.       dosleep()
  1029.     ENDIF
  1030.   ELSE
  1031.     mode:=MODE_CLI
  1032.     FOR scratch:=0 TO 69
  1033.       argarray[scratch]:=NIL
  1034.     ENDFOR
  1035.     rdarg:=ReadArgs('FILE/A/M,TI=TEMPLATE/K,BI=BACKICON/K,MW=MAXIWIDTH/K/N,MH=MAXIHEIGHT/K/N,PX=PICXPOS/K/N,PY=PICYPOS/K/N,PW=PICXSIZE/K/N,PH=PICYSIZE/K/N,SSX=SHOWSIZEX/K/N,SSY=SHOWSIZEY/K/N,HP=HIGHPEN/K/N,QZ=QUANTIZE/K/N,THRES=HAMTHRESHOLD/K/N,NOD=NODITHER/S,C=CENTER/S,FF=FIRSTFOUR/S,FIP=FREEICONPOS/S,CM=CHUNKY/S,F8=FORCEEIGHT/S,SSOL=SHOWSIZEOUTLINE/S,SSN=SHOWSIZENORMAL/S,SST=SHOWSIZETALL/S,LP=LOWPRI/S,Q=QUIET/S,AX=ASPECTX/N,AY=ASPECTY/N,IA=IGNOREASPECT/S,NWI=NOWHATIS/S,NI=NEWICON/S,GS=GREYSCALE/S,LUM=LUMSCALE/S,HAM6=RENDERHAM6/S,HAM8=RENDERHAM8/S,FHB=FULLHAMBASE/S,DE=DISCARDERROR/S,S=STRETCH/S,P=PALETTE/K,ID=ICONDIR/K,BURKES/S,STUCKI/S,ED=ERRORDIFF/S,VER=VERBATIM/S,POP=POPULARITY/S',argarray,0)
  1036.     IF rdarg
  1037.       IF argarray[1]
  1038.         StrCopy(templatename,argarray[1],ALL)
  1039.         stripinfo(templatename)
  1040.       ENDIF
  1041.       IF argarray[2]
  1042.         StrCopy(backname,argarray[2],ALL)
  1043.         stripinfo(backname)
  1044.       ENDIF
  1045.       IF argarray[3]
  1046.         maxiwidth:=argarray[3]
  1047.         maxiwidth:=^maxiwidth
  1048.       ENDIF
  1049.       IF argarray[4]
  1050.         maxiheight:=argarray[4]
  1051.         maxiheight:=^maxiheight
  1052.       ENDIF
  1053.       IF argarray[5]
  1054.         posx:=argarray[5]
  1055.         posx:=^posx
  1056.       ENDIF
  1057.       IF argarray[6]
  1058.         posy:=argarray[6]
  1059.            posy:=^posy
  1060.       ENDIF
  1061.       IF argarray[7]
  1062.         sizex:=argarray[7]
  1063.         sizex:=^sizex
  1064.       ENDIF
  1065.       IF argarray[8]
  1066.         sizey:=argarray[8]
  1067.         sizey:=^sizey
  1068.       ENDIF
  1069.       IF argarray[9]
  1070.         showx:=argarray[9]
  1071.         showx:=^showx
  1072.                 showflag:=TRUE
  1073.       ENDIF
  1074.       IF argarray[10]
  1075.         showy:=argarray[10]
  1076.         showy:=^showy
  1077.                 showflag:=TRUE
  1078.       ENDIF
  1079.       IF argarray[11]
  1080.         first4:=argarray[11]
  1081.         first4:=^first4
  1082.       ENDIF
  1083.       IF argarray[12]
  1084.         quant:=argarray[12]
  1085.         quant:=^quant
  1086.       ENDIF
  1087.       IF argarray[13]
  1088.         hamthres:=argarray[13]
  1089.         hamthres:=^hamthres
  1090.       ENDIF
  1091.  
  1092.             IF argarray[14] THEN dither:=FALSE
  1093.             IF argarray[15] THEN centerflag:=TRUE
  1094.             IF argarray[16] THEN first4:=3
  1095.             IF argarray[17] THEN freeme:=TRUE
  1096.             IF argarray[18] THEN chunkyflag:=TRUE
  1097.             IF argarray[19] THEN force8:=TRUE
  1098.             IF argarray[20] THEN texttype:=TEXT_OUTLINE
  1099.             IF argarray[21] THEN texttype:=TEXT_NORMAL
  1100.             IF argarray[22] THEN tallfont:=TRUE
  1101.             IF argarray[23] THEN SetTaskPri(FindTask(0),-1)
  1102.             IF argarray[24];quietflag:=TRUE;mode:=MODE_QUIET;ENDIF
  1103.       IF argarray[25]
  1104.         aspectx:=argarray[25]
  1105.         aspectx:=limit(^aspectx,1,100)
  1106.       ENDIF
  1107.       IF argarray[26]
  1108.         aspecty:=argarray[26]
  1109.         aspecty:=limit(^aspecty,1,100)
  1110.       ENDIF
  1111.             IF argarray[27] THEN useaspect:=FALSE
  1112.             IF argarray[28] THEN usewhatis:=FALSE
  1113.             IF argarray[29]
  1114.                 IF (newiconbase)
  1115.                     newicon:=TRUE
  1116.                 ENDIF
  1117.             ENDIF
  1118.             IF argarray[30] THEN greyscale:=1
  1119.             IF argarray[31] THEN greyscale:=2
  1120.             IF argarray[32] THEN renderham:=6
  1121.             IF argarray[33] THEN renderham:=8
  1122.             IF argarray[34] THEN hambase:=TRUE
  1123.             IF argarray[35] THEN discard:=TRUE
  1124.             IF argarray[36] THEN stretch:=TRUE
  1125.             IF argarray[37] THEN StrCopy(maptopal,argarray[37],ALL)
  1126.             IF argarray[38] THEN StrCopy(icondir,argarray[38],ALL)
  1127.             IF argarray[39] THEN dithermode:=DITH_BURKES
  1128.             IF argarray[40] THEN dithermode:=DITH_STUCKI
  1129.             IF argarray[41] THEN dithermode:=DITH_ERRORDIFF
  1130.             IF argarray[42] THEN quantmode:=QUANT_VERBATIM
  1131.             IF argarray[43] THEN quantmode:=QUANT_POPULARITY
  1132.         enforcemax()
  1133.       IF argarray[0]
  1134.                 namesptr:=argarray[0]
  1135.                 err:=NIL
  1136.                 WHILE ((namesptr[0]) AND (err=NIL))
  1137.                     StrCopy(patternstr,namesptr[0],ALL)
  1138.                     apath:=New(SIZEOF anchorpath)
  1139.                     first:=FALSE
  1140.                     WHILE err=NIL
  1141.                         IF first=FALSE
  1142.                             err:=MatchFirst(patternstr,apath)
  1143.                             first:=TRUE
  1144.                         ELSE
  1145.                             err:=MatchNext(apath)
  1146.                         ENDIF
  1147.                         IF err=NIL
  1148.                             achain:=apath.last
  1149.                             IF (achain)
  1150.                                 fileinfo:=achain.info
  1151.                                 IF (fileinfo)
  1152.                                     IF (fileinfo.direntrytype<0)
  1153.                                         filestart:=FilePart(patternstr)
  1154.                                         pathlen:=filestart-patternstr
  1155.                                         IF (pathlen)
  1156.                                             StrCopy(filename,patternstr,pathlen)
  1157.                                         ELSE
  1158.                                             StrCopy(filename,'',ALL)
  1159.                                         ENDIF
  1160.                                         AddPart(filename,fileinfo.filename,490)
  1161.                                         StrCopy(dumstr,filename,ALL)
  1162.                                         UpperStr(dumstr)
  1163.                                         IF (InStr(dumstr,'.INFO')<0)
  1164.                                         postprocessicon()
  1165.                                         ENDIF
  1166.                                     ENDIF
  1167.                                 ENDIF
  1168.                             ENDIF
  1169.                         ENDIF
  1170.                     ENDWHILE
  1171.                     MatchEnd(apath)
  1172.                     Dispose(apath)
  1173.                     FOR i:=0 TO 749
  1174.                         IF stacked[i]<>0
  1175.                             StrCopy(filename,stacked[i],ALL)
  1176.                             retu:=processicon()
  1177.                             IF (retu="canc") THEN abort:=TRUE
  1178.                         ENDIF
  1179.                         IF CtrlC();i:=5000;WriteF('***Break\n');ENDIF
  1180.                         IF abort<>FALSE THEN i:=5000
  1181.                     ENDFOR
  1182.                     FOR i:=0 TO 749
  1183.                         IF stacked[i]<>0
  1184.                             DisposeLink(stacked[i])
  1185.                             stacked[i]:=0
  1186.                         ENDIF
  1187.                     ENDFOR
  1188.                     namesptr:=namesptr+4
  1189.                     IF err<>87 THEN err:=0
  1190.                 ENDWHILE
  1191.         StrCopy(filename,argarray[0],ALL)
  1192.       ENDIF
  1193.       FreeArgs(rdarg);rdarg:=NIL
  1194.     ENDIF
  1195.   ENDIF
  1196. ENDPROC
  1197. PROC enforcemax()
  1198.     IF maxiwidth<32 THEN maxiwidth:=32
  1199.     IF maxiwidth>1024 THEN maxiwidth:=1024
  1200.     IF maxiheight<32 THEN maxiheight:=32
  1201.     IF maxiheight>1024 THEN maxiheight:=1024
  1202.         IF (newicon)
  1203.             IF maxiwidth>92 THEN maxiwidth:=92
  1204.             IF maxiheight>92 THEN maxiheight:=92
  1205.         ENDIF
  1206.     maxiw:=maxiwidth-1
  1207.     maxih:=maxiheight-1
  1208.     IF quietflag
  1209.       mode:=MODE_QUIET
  1210.     ENDIF
  1211.     IF sizex>maxiw THEN sizex:=maxiw
  1212.     IF sizey>maxih THEN sizey:=maxih
  1213.     IF posx>=maxiw THEN posx:=maxiw-1
  1214.     IF posy>=maxih THEN posy:=maxih-1
  1215.     IF posx+sizex>maxiw THEN sizex:=maxiw-posx
  1216.     IF posy+sizey>maxih THEN sizey:=maxih-posy
  1217.     IF ((posx) OR (posy) OR (sizex) OR (sizey)) THEN posflag:=TRUE
  1218.     IF sizex=0 THEN sizex:=maxiw-posx
  1219.     IF sizey=0 THEN sizey:=maxih-posy
  1220. ENDPROC
  1221. PROC loadcatalog()
  1222.   IF localebase
  1223.     catalog:=OpenCatalogA(NIL,'picticon.catalog',[OC_BUILTINLANGUAGE,'english',NIL,NIL])
  1224.   ENDIF
  1225.   readstrings()
  1226.   FOR scratch:=0 TO L_ENDS
  1227.     sl[scratch]:=locale(scratch)
  1228.   ENDFOR
  1229. ENDPROC
  1230. PROC locale(strnum)
  1231.   DEF stpoint,defstr
  1232.   defstr:=sl[strnum]
  1233.   IF ((localebase) AND (catalog))
  1234.     stpoint:=GetCatalogStr(catalog,strnum,defstr)
  1235.   ELSE
  1236.     stpoint:=defstr
  1237.   ENDIF
  1238. ENDPROC stpoint
  1239. PROC readstrings()
  1240.   DEF buf,res=0
  1241.   buf:={catstrs}
  1242.   WHILE(Int(buf))<>0
  1243.     res:=res+1
  1244.     IF res>0 AND res<300
  1245.       sl[res]:=buf
  1246.     ENDIF
  1247.     WHILE Char(buf)<>"¶"
  1248.       buf:=buf+1
  1249.     ENDWHILE
  1250.     PutChar(buf,0)
  1251.     buf:=buf+1
  1252.     buf:=(Mul(Div((buf+1),2),2))
  1253.   ENDWHILE
  1254. ENDPROC
  1255. PROC savewinpos() HANDLE
  1256.   DEF buffer=NIL,fhand=0
  1257.  
  1258.     IF ((mode=MODE_CLI) OR (mode=MODE_QUIET)) THEN RETURN
  1259.  
  1260.   iff:=AllocIFF()
  1261.     IF (iff)
  1262.         fhand:=Open('ENV:Picticon.prefs',MODE_NEWFILE)
  1263.         iff.stream:=fhand
  1264.       IF (iff.stream)=NIL THEN Raise(E_NONE)
  1265.       InitIFFasDOS(iff)
  1266.       buffer:=New(100)
  1267.       ierror:=OpenIFF(iff,IFFF_WRITE)
  1268.       IF ierror THEN Raise(E_NONE)
  1269.         PushChunk(iff,"PREF","FORM",IFFSIZE_UNKNOWN)
  1270.         PushChunk(iff,"PREF","PRHD",IFFSIZE_UNKNOWN)
  1271.       PutLong(buffer,0);PutLong(buffer+2,0)
  1272.         WriteChunkBytes(iff,buffer,6)
  1273.        PopChunk(iff)
  1274.  
  1275.        PushChunk(iff,"PREF","WIND",IFFSIZE_UNKNOWN)
  1276.         dumb:=buffer
  1277.         PutLong(dumb,winx);PutLong(dumb+4,winy)
  1278.         WriteChunkBytes(iff,buffer,8)
  1279.        PopChunk(iff)
  1280.       PopChunk(iff)
  1281.     ENDIF
  1282.   Raise(E_NONE)
  1283. EXCEPT
  1284.   IF buffer THEN Dispose(buffer);buffer:=NIL
  1285.   freeiff(666)
  1286.   handleexception(exception)
  1287. ENDPROC
  1288. PROC loadwinpos() HANDLE
  1289.   DEF buffer=NIL
  1290.  
  1291.   iff:=AllocIFF()
  1292.   iff.stream:=Open('ENV:Picticon.prefs',MODE_OLDFILE)
  1293.   IF (iff.stream)=NIL THEN Raise(E_NONE)
  1294.   InitIFFasDOS(iff)
  1295.   buffer:=New(100)
  1296.   ierror:=OpenIFF(iff,IFFF_READ)
  1297.   IF ierror THEN Raise(E_NONE)
  1298.   ierror:=PropChunk(iff,"PREF","WIND")
  1299.   ierror:=StopOnExit(iff,"PREF","FORM")
  1300.   ierror:=ParseIFF(iff,IFFPARSE_SCAN)
  1301.  
  1302.   IF (sp:=FindProp(iff,"PREF","WIND"))
  1303.     dumb:=sp.data
  1304.     winx:=Long(dumb);winy:=Long(dumb+4)
  1305.   ENDIF
  1306.  
  1307.   Raise(E_NONE)
  1308. EXCEPT
  1309.   IF buffer THEN Dispose(buffer)
  1310.   freeiff(666)
  1311.   handleexception(exception)
  1312. ENDPROC
  1313. PROC freeiff(unit)
  1314.   IF iff
  1315.     CloseIFF(iff)
  1316.     IF (iff.stream) THEN Close(iff.stream)
  1317.     FreeIFF(iff)
  1318.     iff:=NIL
  1319.   ENDIF
  1320. ENDPROC
  1321. PROC openlibs()
  1322.   IF (aslbase:=OpenLibrary('asl.library', 36))=NIL THEN CleanUp(25)
  1323.   localebase:=OpenLibrary('locale.library',37)
  1324.   loadcatalog()
  1325.   mathbase:=safeopenlibrary('mathffp.library',39)
  1326.   datatypesbase:=safeopenlibrary('datatypes.library',39)
  1327.   mathtransbase:=safeopenlibrary('mathtrans.library',36)
  1328.   gadtoolsbase:=safeopenlibrary('gadtools.library',36)
  1329.   workbenchbase:=safeopenlibrary('workbench.library',36)
  1330.   iconbase:=safeopenlibrary('icon.library', 36)
  1331.   iffparsebase:=safeopenlibrary('iffparse.library',36)
  1332.   utilitybase:=safeopenlibrary('utility.library',36)
  1333.   diskfontbase:=safeopenlibrary('diskfont.library', 36)
  1334.   whatisbase:=OpenLibrary('whatis.library', 3);IF whatisbase=0 THEN usewhatis:=0
  1335.   newiconbase:=OpenLibrary('newicon.library', 37)
  1336.   IF KickVersion(39);osversion:=TRUE;ELSE;osversion:=FALSE;ENDIF
  1337. ENDPROC
  1338. PROC safeopenlibrary(name,vers) HANDLE
  1339.   DEF lret
  1340.   IF ((lret:=OpenLibrary(name,vers))=NIL) THEN Raise(L_EF_LIBRARY)
  1341.   Raise(E_NONE)
  1342. EXCEPT
  1343.   handleexception(exception)
  1344. ENDPROC lret
  1345. PROC handleexception(except)
  1346.   IF except<>E_NONE THEN errormessage(except)
  1347.   IF quitter THEN leave(quitter)
  1348. ENDPROC
  1349. PROC closelibs()
  1350.     IF whatisbase THEN CloseLibrary(whatisbase)
  1351.   IF newiconbase THEN CloseLibrary(newiconbase)
  1352.   IF diskfontbase THEN CloseLibrary(diskfontbase)
  1353.   IF aslbase THEN CloseLibrary(aslbase)
  1354.   IF iffparsebase THEN CloseLibrary(iffparsebase)
  1355.   IF iconbase THEN CloseLibrary(iconbase)
  1356.   IF workbenchbase THEN CloseLibrary(workbenchbase)
  1357.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  1358.   IF datatypesbase THEN CloseLibrary(datatypesbase)
  1359.   IF layersbase THEN CloseLibrary(layersbase)
  1360.   IF keymapbase THEN CloseLibrary(keymapbase)
  1361.   IF mathbase THEN CloseLibrary(mathbase)
  1362.   IF mathtransbase THEN CloseLibrary(mathtransbase)
  1363.   IF localebase THEN CloseLibrary(localebase)
  1364. ENDPROC
  1365. PROC errormessage(errnum)
  1366.   IF errnum>=L_EF_FATAL
  1367.     errmsg(sl[errnum])
  1368.     quitter:=TRUE
  1369.   ELSE
  1370.     IF errnum>=L_E_GENERAL
  1371.       errmsg(sl[errnum])
  1372.     ELSE
  1373.       errmsg(sl[L_E_GENERAL])
  1374.     ENDIF
  1375.   ENDIF
  1376. ENDPROC
  1377. PROC errmsg(msgptr)
  1378.   IF mode=MODE_CLI
  1379.     WriteF('\s\n\n',msgptr)
  1380.   ELSE
  1381.     IF ((mode=MODE_WB) OR (mode=MODE_APP))
  1382.       displaymessage(msgptr,TRUE)
  1383.       Delay(80)
  1384.     ENDIF
  1385.   ENDIF
  1386. ENDPROC
  1387. PROC sp_div_tf_tf_f(int1,int2)
  1388.   RETURN SpDiv(SpFlt(int1),SpFlt(int2))
  1389. ENDPROC
  1390. PROC leave(flag)
  1391.   IF catalog THEN CloseCatalog(catalog)
  1392.   IF appimagedata THEN FreeMem(appimagedata,3200);appimagedata:=NIL
  1393.   IF curbitmap THEN myfreebitmap(curbitmap);curbitmap:=NIL
  1394.     IF newicon
  1395.         IF newdiskobj THEN FreeNewDiskObject(newdiskobj);newdiskobj:=NIL;diskobj:=NIL
  1396.     ELSE
  1397.       IF diskobj THEN FreeDiskObject(diskobj);diskobj:=NIL
  1398.     ENDIF
  1399.   IF visual THEN FreeVisualInfo(visual);visual:=NIL
  1400.   IF toolobject THEN FreeDiskObject(toolobject);toolobject:=NIL
  1401.  
  1402.   closelibs()
  1403.     END iinfo
  1404.  
  1405.   IF flag
  1406.     IF flag=TRUE
  1407.       CleanUp(0)
  1408.     ELSE
  1409.       CleanUp(flag)
  1410.     ENDIF
  1411.   ENDIF
  1412. ENDPROC
  1413.  
  1414. PROC myallocbitmap(w,h,d,type,tags)
  1415.   IF osversion=TRUE
  1416.     RETURN AllocBitMap(w,h,d,type,tags)
  1417.   ENDIF
  1418. ENDPROC
  1419.  
  1420. PROC myfreebitmap(bm)
  1421.   IF osversion=TRUE
  1422.     RETURN FreeBitMap(bm)
  1423.   ELSE
  1424.   ENDIF
  1425. ENDPROC
  1426.  
  1427. /*PROC findcolor(colap,ared,agrn,ablu)
  1428.   DEF pointred,pointgrn,pointblu,mpen
  1429.   mpen:=-1
  1430.   IF (first4>0) THEN mpen:=first4
  1431.   pointred:=Shl(Shl(Shl(ared,8),8),8)
  1432.   pointgrn:=Shl(Shl(Shl(agrn,8),8),8)
  1433.   pointblu:=Shl(Shl(Shl(ablu,8),8),8)
  1434.   RETURN FindColor(colap,pointred,pointgrn,pointblu,mpen)
  1435. ENDPROC
  1436. */
  1437. /*PROC mygetrgb32(colmap,first,ncolors,table)
  1438.   DEF rre,eee
  1439.   IF osversion=TRUE
  1440.     GetRGB32(colmap,first,ncolors,table)
  1441.   ELSE
  1442.     rre:=GetRGB4(colmap,first)
  1443.     eee:=(rre AND $F)
  1444.     PutChar(table,eee)
  1445.     PutChar(table+1,eee)
  1446.     PutChar(table+2,eee)
  1447.     PutChar(table+3,eee)
  1448.     eee:=Shr((rre AND $F0),4)
  1449.     PutChar(table+4,eee)
  1450.     PutChar(table+5,eee)
  1451.     PutChar(table+6,eee)
  1452.     PutChar(table+7,eee)
  1453.     eee:=Shr((rre AND $F00),8)
  1454.     PutChar(table+8,eee)
  1455.     PutChar(table+9,eee)
  1456.     PutChar(table+10,eee)
  1457.     PutChar(table+11,eee)
  1458.   ENDIF
  1459. ENDPROC*/
  1460. PROC processname(name,dir,file)
  1461.  
  1462.   DEF wish[20]:STRING
  1463.  
  1464.   StrCopy(name,dir,ALL)
  1465.   IF StrLen(file)            /* IF a file (NOT DISK/DRAWER) */
  1466.     RightStr(wish,name,1)
  1467.     IF StrCmp(wish,':',1)=NIL       /*  DISK:DIR/NAME */
  1468.       StrAdd(name,'/',ALL)
  1469.     ENDIF
  1470.     StrAdd(name,file,ALL)
  1471.   ELSE
  1472.     RightStr(wish,name,1)
  1473.     IF StrCmp(wish,':',1)        /* DISK:  (so add disk) */
  1474.       StrAdd(name,'disk',ALL)
  1475.     ENDIF
  1476.     IF StrCmp(wish,'/',1)        /* DISK:DIR/DIR/  (delete '/' */
  1477.       MidStr(name,name,0,StrLen(name)-1)
  1478.     ENDIF
  1479.   ENDIF
  1480.   MidStr(wish,name,0,1)
  1481.   IF StrCmp(wish,'/',1)
  1482.     MidStr(name,name,1,ALL)
  1483.   ENDIF
  1484.   stripinfo(name)
  1485. ENDPROC
  1486. PROC stripinfo(name)
  1487.   DEF comp1[6]:STRING,comp2[6]:STRING
  1488.  
  1489.   StrCopy(comp1,'.INFO',ALL)
  1490.   MidStr(comp2,name,StrLen(name)-5,5)
  1491.   UpperStr(comp2)
  1492.   IF StrCmp(comp1,comp2,5)
  1493.     MidStr(name,name,0,(StrLen(name)-5))
  1494.   ENDIF
  1495. ENDPROC
  1496. /*PROC grabrgbtables()
  1497.   DEF cmtable
  1498.   cmtable:=[0,0,0,0,0,0]:LONG
  1499.   FOR scratch:=0 TO Shl(1,depth)-1
  1500.     mygetrgb32(newcolormap,scratch,1,cmtable)
  1501.     redt[scratch]:=Char(cmtable)
  1502.     grnt[scratch]:=Char(cmtable+4)
  1503.     blut[scratch]:=Char(cmtable+8)
  1504.   ENDFOR
  1505. ENDPROC
  1506. */
  1507. PROC stripselect(flags)
  1508.   IF (flags AND GFLG_GADGHIMAGE) THEN flags:=flags-GFLG_GADGHIMAGE
  1509.   IF (flags AND GFLG_GADGHCOMP) THEN flags:=flags-GFLG_GADGHCOMP
  1510.   IF (flags AND GADGBACKFILL) THEN flags:=flags-GADGBACKFILL
  1511. ENDPROC flags
  1512.  
  1513.  
  1514. PROC copybitmap2image(sb,di,nb,ys,dp,savedepth)
  1515.  
  1516.   DEF plane,cp,cr,cb,byte,sbs=NIL:PTR TO mybitmapstruct
  1517.  
  1518.   sbs:=sb;byte:=di
  1519.   FOR plane:=1 TO savedepth
  1520.     IF plane>dp         /* If save plane is not edited, use highest that was */
  1521.       SELECT dp
  1522.         CASE 1;cp:=sbs.plane1
  1523.         CASE 2;cp:=sbs.plane2
  1524.         CASE 3;cp:=sbs.plane3
  1525.         CASE 4;cp:=sbs.plane4
  1526.         CASE 5;cp:=sbs.plane5
  1527.         CASE 6;cp:=sbs.plane6
  1528.         CASE 7;cp:=sbs.plane7
  1529.         CASE 8;cp:=sbs.plane8
  1530.       ENDSELECT
  1531.     ELSE
  1532.       SELECT plane
  1533.         CASE 1;cp:=sbs.plane1
  1534.         CASE 2;cp:=sbs.plane2
  1535.         CASE 3;cp:=sbs.plane3
  1536.         CASE 4;cp:=sbs.plane4
  1537.         CASE 5;cp:=sbs.plane5
  1538.         CASE 6;cp:=sbs.plane6
  1539.         CASE 7;cp:=sbs.plane7
  1540.         CASE 8;cp:=sbs.plane8
  1541.       ENDSELECT
  1542.     ENDIF
  1543.     FOR cr:=0 TO ys-1
  1544.       FOR cb:=0 TO nb-1
  1545.         MOVE.L byte,A0
  1546.         MOVE.L cp,A1
  1547.         MOVE.B (A1),(A0)
  1548.         byte:=byte+1;cp:=cp+1
  1549.       ENDFOR
  1550.       cp:=cp+(sbs.bytesperrow-nb)
  1551.     ENDFOR
  1552.   ENDFOR
  1553. ENDPROC
  1554.  
  1555. PROC copyrast2image(sb,di,nb,ys,dp,savedepth)
  1556.  
  1557.   DEF plane,cp,cr,cb,byte,sbs=NIL:PTR TO mybitmapstruct
  1558.  
  1559.   byte:=di
  1560.   FOR plane:=0 TO savedepth-1
  1561.     ditz:=Shl(1,smaller(plane,dp))
  1562.     FOR cr:=0 TO ys-1
  1563.       FOR cb:=0 TO nb-1
  1564.         body:=0
  1565.         FOR dang:=7 TO 0 STEP -1
  1566.           dumb:=ReadPixel(sb,(cb*8)+(7-dang),cr)
  1567.           IF (dumb AND ditz) THEN body:=(body OR Shl(1,dang))
  1568.         ENDFOR
  1569.         PutChar(byte,body)
  1570.         byte:=byte+1
  1571.       ENDFOR
  1572.     ENDFOR
  1573.   ENDFOR
  1574. ENDPROC
  1575.  
  1576. PROC findsize(rast1)
  1577.   DEF li,lt,a
  1578.   requestsizex:=NIL;requestsizey:=NIL
  1579.   FOR li:=0 TO maxih;FOR lt:=0 TO maxiw
  1580.       a:=ReadPixel(rast1,lt,li)
  1581.       IF (a)
  1582.         IF lt>requestsizex;requestsizex:=lt;ENDIF
  1583.         IF li>requestsizey;requestsizey:=li;ENDIF
  1584.       ENDIF
  1585.       IF a>highestcolor;highestcolor:=a;ENDIF
  1586.     ENDFOR;ENDFOR
  1587.   requestsizex:=requestsizex+1;requestsizey:=requestsizey+2
  1588. ENDPROC
  1589.  
  1590. PROC restorediskobj(diskobj:PTR TO diskobject)
  1591.   DEF gadget:PTR TO gadget
  1592.   gadget:=diskobj.gadget
  1593.   gadget.gadgetrender:=k[0]
  1594.   gadget.selectrender:=k[1]
  1595.   gadget.flags:=k[2]
  1596.   diskobj.drawerdata:=k[3]
  1597.   Dispose(k[4]);k[4]:=NIL
  1598.   Dispose(k[5]);k[5]:=NIL
  1599.   Dispose(k[6]);k[6]:=NIL
  1600.   diskobj.type:=k[7]
  1601.   IF k[9]  THEN FreeMem(k[9], k[8])
  1602.   IF k[10] THEN FreeMem(k[10],k[8])
  1603.   k[9]:=NIL
  1604.   k[10]:=NIL
  1605. ENDPROC
  1606.  
  1607. PROC doloadpalette(name,cmap) HANDLE
  1608.     DEF    iff=NIL:PTR TO iffhandle
  1609.     DEF ditz,dang,dumb,scratch,body
  1610.     DEF sp=NIL:PTR TO storedproperty
  1611.     DEF res,pennum=-1
  1612.  
  1613.     iff:=AllocIFF()
  1614.     iff.stream:=Open(name,MODE_OLDFILE)
  1615.     IF (iff.stream)
  1616.         InitIFFasDOS(iff)
  1617.         IF (OpenIFF(iff,IFFF_READ))=0
  1618.             PropChunk(iff,"ILBM","CMAP")
  1619.             StopOnExit(iff,"ILBM","FORM")
  1620.             ParseIFF(iff,IFFPARSE_SCAN)
  1621.             IF (sp:=FindProp(iff,"ILBM","CMAP"))
  1622.                 body:=sp.data
  1623.                 FOR scratch:=0 TO 255
  1624.                     SetRGB32CM(cmap,scratch,$EEEEEE00,$ABCDACBD,$DDEECC22)
  1625.                 ENDFOR
  1626.                 FOR scratch:=0 TO (sp.size/3)-1
  1627.                     ditz:=Char(body++)
  1628.                     dang:=Char(body++)
  1629.                     dumb:=Char(body++)
  1630.                     SetRGB32CM(cmap,scratch,byte2long(ditz),byte2long(dang),byte2long(dumb))
  1631.                     pennum:=pennum+1
  1632.                 ENDFOR
  1633.             ENDIF
  1634.         ENDIF
  1635.     ENDIF
  1636. EXCEPT DO
  1637.     res:=exception
  1638.     IF iff
  1639.         CloseIFF(iff)
  1640.         IF (iff.stream) THEN Close(iff.stream)
  1641.         FreeIFF(iff)
  1642.     ENDIF
  1643. ENDPROC res,pennum
  1644.  
  1645. PROC creatediskobj(diskobj:PTR TO diskobject,rast1:PTR TO rastport) HANDLE
  1646.   DEF gadget:PTR TO gadget
  1647.   DEF iconsizex,iconsizey,highplane
  1648.   DEF numbyteswide,savedepthhow,sizetmp
  1649.   DEF i1:PTR TO image,i2:PTR TO image
  1650.   DEF bitm1
  1651.  
  1652.   gadget:=diskobj.gadget
  1653.   k[0]:=gadget.gadgetrender
  1654.   k[1]:=gadget.selectrender
  1655.   k[2]:=gadget.flags
  1656.   k[3]:=diskobj.drawerdata
  1657.   k[4]:=New(SIZEOF image)
  1658.   k[5]:=New(SIZEOF image)
  1659.   k[6]:=New(SIZEOF drawerdata)
  1660.   k[7]:=diskobj.type
  1661.   k[8]:=0
  1662.   k[9]:=0
  1663.   highestcolor:=0
  1664.   bitm1:=curbitmap
  1665.  
  1666.   findsize(rast1)
  1667.   iconsizex:=(bigger(bigger(requestsizex,(desx+desw)),10))
  1668.   iconsizey:=(bigger(bigger(requestsizey,(desy+desh)),10))
  1669.  
  1670.   numbyteswide:=((iconsizex+15)/16)*2
  1671.   savedepthhow:=depth
  1672.   IF (force8) THEN savedepthhow:=8
  1673.   sizetmp:=(numbyteswide*iconsizey*savedepthhow)+1000
  1674.  
  1675.   k[8]:=sizetmp
  1676.   k[9]:=AllocMem(sizetmp,(MEMF_CHIP OR MEMF_CLEAR))
  1677.   k[10]:=AllocMem(sizetmp,(MEMF_CHIP OR MEMF_CLEAR))
  1678.   IF ((k[9]=NIL) OR (k[10]=NIL)) THEN Raise(L_EF_CHIPBUFFER)
  1679.  
  1680.   IF chunkyflag=NIL
  1681.     copybitmap2image(bitm1,k[9],numbyteswide,iconsizey-1,depth,savedepthhow)
  1682.   ELSE
  1683.     copyrast2image(rast1,k[9],numbyteswide,iconsizey-1,depth,savedepthhow)
  1684.   ENDIF
  1685.   i1:=k[4];i2:=k[5]
  1686.   i1.leftedge:=0;i1.topedge:=0;i1.width:=iconsizex
  1687.   i1.height:=iconsizey-1;i1.depth:=8;i1.imagedata:=k[9]
  1688.   i1.planepick:=0;i1.planeonoff:=0;i1.nextimage:=NIL
  1689.   i2.leftedge:=0;i2.topedge:=0;i2.width:=iconsizex
  1690.   i2.height:=iconsizey-1;i2.depth:=8;i2.imagedata:=k[10]
  1691.   i2.planepick:=0;i2.planeonoff:=0;i2.nextimage:=NIL
  1692.  
  1693.   highplane:=1
  1694.   IF highestcolor>1;highplane:=2;ENDIF
  1695.   IF highestcolor>3;highplane:=3;ENDIF
  1696.   IF highestcolor>7;highplane:=4;ENDIF
  1697.   IF highestcolor>15;highplane:=5;ENDIF
  1698.   IF highestcolor>31;highplane:=6;ENDIF
  1699.   IF highestcolor>63;highplane:=7;ENDIF
  1700.   IF highestcolor>127;highplane:=8;ENDIF
  1701.   IF (force8)
  1702.     i1.depth:=8
  1703.     i2.depth:=8
  1704.   ELSE
  1705.     i1.depth:=highplane
  1706.     i2.depth:=highplane
  1707.   ENDIF
  1708.   gadget.width:=iconsizex;gadget.height:=iconsizey;gadget.gadgetrender:=i1
  1709.   gadget.selectrender:=NIL
  1710.   IF freeme=TRUE
  1711.     diskobj.currentx:=NO_ICON_POSITION
  1712.     diskobj.currenty:=NO_ICON_POSITION
  1713.   ENDIF
  1714.   gadget.flags:=stripselect(gadget.flags)
  1715.   gadget.flags:=(gadget.flags OR GFLG_GADGHCOMP)
  1716.   diskobj.type:=WBPROJECT
  1717.  
  1718.   Raise(E_NONE)
  1719. EXCEPT
  1720.   IF exception<>E_NONE
  1721.     errormessage(exception)
  1722.   ENDIF
  1723.   IF quitter THEN leave(quitter)
  1724. ENDPROC
  1725.  
  1726. PROC yup(s) IS (MatchToolValue(s,{yes}) OR MatchToolValue(s,{true}))
  1727. PROC nope(s) IS (MatchToolValue(s,{no}) OR MatchToolValue(s,{false}))
  1728. PROC threshold(val,th);IF Abs(val)<=th THEN RETURN 0;ENDPROC val
  1729.  
  1730. /*PROC domethod( obj:PTR TO object, msg:PTR TO msg )
  1731.   DEF h:PTR TO hook, o:PTR TO object, dispatcher
  1732.   IF obj
  1733.     o := obj-SIZEOF object     /* instance data is to negative offset */
  1734.     h := o.class
  1735.     dispatcher := h.entry      /* get dispatcher from hook in iclass */
  1736.     MOVEA.L h,A0
  1737.     MOVEA.L msg,A1
  1738.     MOVEA.L obj,A2           /* probably should use CallHookPkt, but the */
  1739.     MOVEA.L dispatcher,A3    /*   original code (DoMethodA()) doesn't. */
  1740.     JSR (A3)                 /* call classDispatcher() */
  1741.     MOVE.L D0,o
  1742.     RETURN o
  1743.   ENDIF
  1744. ENDPROC NIL */
  1745.  
  1746. PROC copyimagerast(rastp:PTR TO rastport,image)
  1747.   DrawImage(rastp,image,0,0)
  1748. ENDPROC
  1749.  
  1750. catstrs:
  1751.   CHAR 'Ok¶'
  1752.   CHAR 'Error: A general error has occured.¶'
  1753.   CHAR 'Error: File not found.¶'
  1754.   CHAR 'Error: Could not open file.¶'
  1755.   CHAR 'Error: Problems with icon.¶'
  1756.   CHAR 'Error: Unable to write icon file.¶'
  1757.   CHAR 'Error: Problems opening clipboard.¶'
  1758.   CHAR 'Error: Problems with datatype.¶'
  1759.   CHAR 'Error: Datatype is not a picture.¶'
  1760.   CHAR 'Error: Problems creating gadgets.¶'
  1761.   CHAR 'Error: Could not open a required library.¶'
  1762.   CHAR 'Error: An undefined FATAL error has occured.¶'
  1763.   CHAR 'Fatal Error: Could not lock a public screen.¶'
  1764.   CHAR 'Fatal Error: Not enough CHIP memory\n        for a required buffer.¶'
  1765.   CHAR 'Fatal Error: Could not obtain a visual lock.¶'
  1766.   CHAR 'Fatal Error: Unable to create menus.¶'
  1767.   CHAR 'Fatal Error: Could not open a port.¶'
  1768.   CHAR 'Fatal Error: Unable to open window.¶'
  1769.   CHAR 'Error: Unable to allocate some memory.¶'
  1770.   CHAR 'Picticon Status¶'
  1771.   CHAR 'File: "\s"¶'
  1772.   CHAR '(\d of \d items)¶'
  1773.   CHAR 'Loading...¶'
  1774.   CHAR '*¶'
  1775.   CHAR '*¶'
  1776.   CHAR 'Saving icon.¶'
  1777.   CHAR '*¶'
  1778.   CHAR 'Picticon¶'
  1779.   CHAR 'Copyright ©1993-95\n by Chad Randall\n\nThis software is freely re-distributable.\n\nDo you wish to quit?¶'
  1780.   CHAR 'Quit|Cancel¶'
  1781.   CHAR 'Rendering...¶'
  1782.   CHAR '(\d%% done.)¶'
  1783.   CHAR '(directory)¶'
  1784.     CHAR 'Creating icon...¶'
  1785.     CHAR 'Loading Datatype...¶'
  1786.     CHAR 'Scaling...¶'
  1787.     CHAR 'Generating Histogram...¶'
  1788.     CHAR 'Picking Colors...¶'
  1789.     CHAR 'Rendering...¶'
  1790.     CHAR 'Cancel¶'
  1791.     CHAR 'Picticon v1.4¶'
  1792.  
  1793.   LONG 0,0,0
  1794.  
  1795. chardata:
  1796.  
  1797.   CHAR '.xxx...'
  1798.   CHAR 'x...x..'
  1799.   CHAR 'x...x..'
  1800.   CHAR 'x...x..'
  1801.   CHAR 'x...x..'
  1802.   CHAR '.xxx...'
  1803.  
  1804.   CHAR '..x....'
  1805.   CHAR '..x....'
  1806.   CHAR '..x....'
  1807.   CHAR '..x....'
  1808.   CHAR '..x....'
  1809.   CHAR '..x....'
  1810.  
  1811.   CHAR 'xxxxx..'
  1812.   CHAR '....x..'
  1813.   CHAR '..xxx..'
  1814.   CHAR '.x.....'
  1815.   CHAR 'x......'
  1816.   CHAR 'xxxxx..'
  1817.  
  1818.   CHAR 'xxxx...'
  1819.   CHAR '....x..'
  1820.   CHAR '..xx...'
  1821.   CHAR '....x..'
  1822.   CHAR '....x..'
  1823.   CHAR 'xxxx...'
  1824.  
  1825.   CHAR '...x...'
  1826.   CHAR '..xx...'
  1827.   CHAR '.x.x...'
  1828.   CHAR 'xxxxx..'
  1829.   CHAR '...x...'
  1830.   CHAR '...x...'
  1831.  
  1832.   CHAR 'xxxxx..'
  1833.   CHAR 'x......'
  1834.   CHAR 'xxxx...'
  1835.   CHAR '....x..'
  1836.   CHAR '....x..'
  1837.   CHAR 'xxxx...'
  1838.  
  1839.   CHAR '.xxx...'
  1840.   CHAR 'x......'
  1841.   CHAR 'xxxx...'
  1842.   CHAR 'x...x..'
  1843.   CHAR 'x...x..'
  1844.   CHAR '.xxx...'
  1845.  
  1846.   CHAR 'xxxxx..'
  1847.   CHAR '....x..'
  1848.   CHAR '...x...'
  1849.   CHAR '..x....'
  1850.   CHAR '..x....'
  1851.   CHAR '..x....'
  1852.  
  1853.   CHAR '.xxx...'
  1854.   CHAR 'x...x..'
  1855.   CHAR '.xxx...'
  1856.   CHAR 'x...x..'
  1857.   CHAR 'x...x..'
  1858.   CHAR '.xxx...'
  1859.  
  1860.   CHAR '.xxx...'
  1861.   CHAR 'x...x..'
  1862.   CHAR '.xxxx..'
  1863.   CHAR '....x..'
  1864.   CHAR '....x..'
  1865.   CHAR '.xxx...'
  1866.  
  1867. xdata:
  1868.   CHAR '.......'
  1869.   CHAR '.......'
  1870.   CHAR '.x.x...'
  1871.   CHAR '..x....'
  1872.   CHAR '.x.x...'
  1873.   CHAR '.......'
  1874.  
  1875. chardatal:
  1876.  
  1877.   CHAR '.xxx...'
  1878.   CHAR 'x...x..'
  1879.   CHAR 'x...x..'
  1880.   CHAR 'x...x..'
  1881.   CHAR 'x...x..'
  1882.   CHAR 'x...x..'
  1883.   CHAR 'x...x..'
  1884.   CHAR '.xxx...'
  1885.  
  1886.   CHAR '..x....'
  1887.   CHAR '..x....'
  1888.   CHAR '..x....'
  1889.   CHAR '..x....'
  1890.   CHAR '..x....'
  1891.   CHAR '..x....'
  1892.   CHAR '..x....'
  1893.   CHAR '..x....'
  1894.  
  1895.   CHAR '.xxx...'
  1896.   CHAR 'x...x..'
  1897.   CHAR '....x..'
  1898.   CHAR '...x...'
  1899.   CHAR '..x....'
  1900.   CHAR '.x.....'
  1901.   CHAR 'x......'
  1902.   CHAR 'xxxxx..'
  1903.  
  1904.   CHAR '.xxx...'
  1905.   CHAR 'x...x..'
  1906.   CHAR '....x..'
  1907.   CHAR '..xx...'
  1908.   CHAR '....x..'
  1909.   CHAR '....x..'
  1910.   CHAR 'x...x..'
  1911.   CHAR '.xxx...'
  1912.  
  1913.   CHAR '...x...'
  1914.   CHAR '..xx...'
  1915.   CHAR '.x.x...'
  1916.   CHAR 'x..x...'
  1917.   CHAR 'xxxxx..'
  1918.   CHAR '...x...'
  1919.   CHAR '...x...'
  1920.   CHAR '...x...'
  1921.  
  1922.   CHAR 'xxxxx..'
  1923.   CHAR 'x......'
  1924.   CHAR 'x......'
  1925.   CHAR 'xxxx...'
  1926.   CHAR '....x..'
  1927.   CHAR '....x..'
  1928.   CHAR '....x..'
  1929.   CHAR 'xxxx...'
  1930.  
  1931.   CHAR '.xxx...'
  1932.   CHAR 'x......'
  1933.   CHAR 'x......'
  1934.   CHAR 'xxxx...'
  1935.   CHAR 'x...x..'
  1936.   CHAR 'x...x..'
  1937.   CHAR 'x...x..'
  1938.   CHAR '.xxx...'
  1939.  
  1940.   CHAR 'xxxxx..'
  1941.   CHAR '....x..'
  1942.   CHAR '....x..'
  1943.   CHAR '...x...'
  1944.   CHAR '..x....'
  1945.   CHAR '..x....'
  1946.   CHAR '..x....'
  1947.   CHAR '..x....'
  1948.  
  1949.   CHAR '.xxx...'
  1950.   CHAR 'x...x..'
  1951.   CHAR 'x...x..'
  1952.   CHAR '.xxx...'
  1953.   CHAR 'x...x..'
  1954.   CHAR 'x...x..'
  1955.   CHAR 'x...x..'
  1956.   CHAR '.xxx...'
  1957.  
  1958.   CHAR '.xxx...'
  1959.   CHAR 'x...x..'
  1960.   CHAR 'x...x..'
  1961.   CHAR '.xxxx..'
  1962.   CHAR '....x..'
  1963.   CHAR '....x..'
  1964.   CHAR 'x...x..'
  1965.   CHAR '.xxx...'
  1966.  
  1967. xdatal:
  1968.   CHAR '.......'
  1969.   CHAR '.......'
  1970.   CHAR 'x...x..'
  1971.   CHAR '.x.x...'
  1972.   CHAR '..x....'
  1973.   CHAR '.x.x...'
  1974.   CHAR 'x...x..'
  1975.   CHAR '.......'
  1976.  
  1977. controlstring:
  1978.   CHAR 10,$B,0,0,0,0
  1979.   CHAR $9B,"1",$53,$0,$0,$0,$0
  1980.  
  1981. versionstring:
  1982. CHAR 0,0,0,0
  1983. CHAR '\0$VER: picticon 1.4 (7.6.95)',10,13
  1984. CHAR 0,0,0,0
  1985.  
  1986.